home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 2 / Gold Medal Software Volume 2 (Gold Medal) (1994).iso / prog / hcn305.arj / GSOB_DSK.PAS < prev    next >
Pascal/Delphi Source File  |  1993-08-07  |  23KB  |  820 lines
  1. Unit GSOB_Dsk;
  2. {------------------------------------------------------------------------------
  3.                                Disk File Handler
  4.  
  5.        GSOB_DSK Copyright (c)  Richard F. Griffin
  6.  
  7.        01 April 1993
  8.  
  9.        102 Molded Stone Pl
  10.        Warner Robins, GA  31088
  11.  
  12.        -------------------------------------------------------------
  13.        This unit handles the objects for all untyped disk file I/O.
  14.  
  15.        File Sharing Routines are derived from:
  16.  
  17.           Lock4 - DOS 3 Record Locking for Turbo Pascal 4.0
  18.           version 1.0 11/16/87
  19.           by Richard Sadowsky, CompuServe 74017,1670
  20.           Released to the public domain
  21.  
  22.        File Handle Extension Routine is derived from:
  23.  
  24.           EXTEND.PAS - Increase File Handle Count to 255
  25.           Version 3.2  September 25, 1988
  26.           by Scott Bussinger, Compuserve 72247,2671
  27.           Released to the public domain
  28.  
  29.        File Flushing Routine is derived from:
  30.  
  31.           FLUSH.PAS - Replacement for Turbo Pascal Flush Procedure
  32.           Version 1.2  January 9, 1986
  33.           by Randy Forgaard, CompuServe 70307,521
  34.           Released to the public domain
  35.  
  36.        changes:
  37.  
  38.           15 Jul 93 - Fixes problem with the flush after write in Write
  39.                       and AddToFile methods.  Flush supposedly removes locks,
  40.                       so record locking was reestablished.  This caused
  41.                       access denied problems on Novell Lans.  Removed the
  42.                       relocking routine.
  43.  
  44.           22 Jul 93 - Fixes problem with detecting a read-only file.  In the
  45.                       Assign method, FileMode is set to ReadOnly if the read
  46.                       only file attribute is set in the file.  If a network
  47.                       file, SharedDenyWrite is also set.
  48.  
  49.           07 Aug 93 - Added statement to clear IOResult before attempting to
  50.                       make an IO call.  If IOResult is non-zero when a
  51.                       command is issued, it is possible the routine will
  52.                       get that result code instead of the valid result.
  53.  
  54. -------------------------------------------------------------------------------}
  55.  
  56. {$O-,V-}     {Cannot be Overlayed!!}
  57.  
  58. interface
  59. uses
  60.    GSOB_Var,
  61.    {$IFDEF WINDOWS}
  62.       WinDOS,
  63.       WinProcs,
  64.       Objects,
  65.       Strings;
  66.    {$ELSE}
  67.       DOS,
  68.       GSOB_Obj;
  69.    {$ENDIF}
  70.  
  71.  
  72. const
  73.  
  74.    {File Modes (including sharing)}
  75.  
  76.    dfReadOnly        = 0;
  77.    dfWriteOnly       = 1;
  78.    dfReadWrite       = 2;
  79.    dfSharedDenyAll   = 16;
  80.    dfSharedDenyWrite = 32;
  81.    dfSharedDenyRead  = 48;
  82.    dfSharedDenyNone  = 64;
  83.  
  84.    dfDirtyRead : longint = $40000000;
  85.  
  86. type
  87.  
  88.    {$IFNDEF WINDOWS}
  89.       TFileRec    = FileRec;
  90.       TRegisters  = Registers;
  91.       TSearchRec  = SearchRec;
  92.       TDateTime   = DateTime;
  93.    {$ENDIF}
  94.  
  95.  
  96.  
  97.    dfFlushStatus = (NeverFlush,WriteFlush,AppendFlush,UnLockFlush);
  98.  
  99.    GSP_DiskFile = ^GSO_DiskFile;
  100.    GSO_DiskFile = Object(TObject)
  101.       dfFileHndl : word;
  102.       dfFileErr  : word;       {I/O error code}
  103.       dfFileExst : boolean;    {True if file exists}
  104.       dfFileName : string[80];
  105.       dfFilePosn : longint;
  106.       dfFileRSiz : word;
  107.       dfFileShrd : boolean;
  108.       dfFileMode : byte;
  109.       dfFileType : file;
  110.       dfFileInfo : TSearchRec;
  111.       dfFileFlsh : dfFlushStatus;
  112.       dfGoodRec  : word;
  113.       dfLockRec  : Boolean;
  114.       dfLockPos  : Longint;
  115.       dfLockLth  : Longint;
  116.  
  117.       Constructor  Init(Fname : string; Fmode : byte);
  118.       destructor   Done; virtual;
  119.       Procedure    AddtoFile(var dat; len, StepBack : word); virtual;
  120.       Procedure    Assign(FName : string); virtual;
  121.       Procedure    Close; virtual;
  122.       Procedure    Erase; virtual;
  123.       Procedure    Error(Code, Info : integer); virtual;
  124.       Function     FileSize : longint; virtual;
  125.       Procedure    Flush; virtual;
  126.       Function     LockFile : Word; virtual;
  127.       Function     LockRec(FilePosition,FileLength : LongInt) : Word; virtual;
  128.       Procedure    Read(blk : longint; var dat; len : word); virtual;
  129.       Procedure    Rename(Fname : string); virtual;
  130.       Procedure    Reset(len : word); virtual;
  131.       Procedure    ReWrite(len : word); virtual;
  132.       Procedure    SetFlushCondition(Condition : dfFlushStatus); virtual;
  133.       Procedure    Truncate(loc : longint); virtual;
  134.       Function     UnLock : Word; virtual;
  135.       Procedure    Write(blk : longint; var dat; len : word); virtual;
  136.    end;
  137.  
  138. Var
  139.    FindFileInfo : TSearchRec;
  140.  
  141.  
  142. Procedure GS_ClearLocks;
  143. Function  GS_ExtendHandles(HndlCount : byte) : boolean;
  144. Procedure GS_FileDateTime(var f: file; var Year,Month,Day,Hour,Min,Sec: Word);
  145. Function  GS_FileExists(Fname : string) : boolean;
  146. Function  GS_FileIsOpen(fnam : string): boolean;
  147. Function  GS_Flush(Hndl : word): Word;
  148. Function  GS_LockFile(Hndl : word; FilePosition,FileLength : LongInt) : Word;
  149. Function  GS_RetryFile(Wait,Retry : Word) : Word;
  150. Function  GS_UnLockFile(Hndl : word; FilePosition,FileLength : LongInt) : Word;
  151. Function  GS_ShareAllowed : boolean;
  152. Procedure GS_ShareAuto(tf : boolean);
  153. Function  GS_AutoShare : boolean;
  154. Function  GS_Exclusive : boolean;
  155. Procedure GS_SetExclusive(tf : boolean);
  156. {------------------------------------------------------------------------------
  157.                             IMPLEMENTATION SECTION
  158. ------------------------------------------------------------------------------}
  159.  
  160. implementation
  161.  
  162. const
  163.    RetriesChgd   : boolean = false;
  164.    AutomaticShare: boolean = false;
  165.    ShareChecked  : boolean = false;
  166.    ShareAllowed  : boolean = false;
  167.    UseExclusive  : boolean = true;
  168.    HandlesExtnd  : boolean = false;
  169.  
  170. var
  171.    istrue        : boolean;
  172.    ExitSave      : pointer;
  173.    ObjtLog       : TCollection;
  174.  
  175.    NewHandleTable: array[0..255] of byte;   { New table for handles }
  176.    OldHandleTable: pointer;                 { Pointer to original table }
  177.    OldNumHandles : byte;                    { Original number of handles }
  178.  
  179.  
  180. {------------------------------------------------------------------------------
  181.                             Internal Functions
  182. ------------------------------------------------------------------------------}
  183.  
  184. function HiLong(Long : LongInt) : Word;
  185. { This inline directive is similar to Turbo's Hi() function, except }
  186. { it returns the high word of a LongInt                             }
  187. Inline(
  188.   $5A/       {pop      dx    ; low word of long}
  189.   $58);      {pop      ax    ; hi word of long}
  190.  
  191. function LowLong(Long : LongInt) : Word;
  192. { This inline directive is similar to Turbo's Lo() function, except }
  193. { it returns the Low word of a LongInt                              }
  194. Inline(
  195.   $5A/       {pop      dx    ; low word of long}
  196.   $58/       {pop      ax    ; hi word of long}
  197.   $89/$D0);  {mov      ax,dx ; return lo word as function result in Ax}
  198.  
  199.  
  200.  
  201. function Temp_File : string;
  202. var
  203.    h, mn, s, hund : Word;
  204.    hundchk        : Word;
  205.    LS             : string;
  206. begin
  207.    GetTime(h,mn,s,hund);           {Call TP 5.5 procedure for current time}
  208.    hundchk := hund;
  209.    repeat
  210.       GetTime(h,mn,s,hund);        {Call TP 5.5 procedure for current time}
  211.    until hundchk <> hund;             {Ensures always a unique time}
  212.    LS := 'GS'+chr((mn div 10)+65)+chr((mn mod 10)+65);
  213.    LS := LS+chr((s div 10)+65)+chr((s mod 10)+65);
  214.    LS := LS+chr((hund div 10)+65)+chr((hund mod 10)+65);
  215.    LS := LS+'.$$$';
  216.    Temp_File := LS;                {Return the unique field}
  217.  end;
  218.  
  219.  
  220. {------------------------------------------------------------------------------
  221.                               Global Routines
  222. ------------------------------------------------------------------------------}
  223.  
  224. Function FileNameIs(hdl: word): string ;
  225. var
  226.    i    : integer;
  227.    rslt : word;
  228.    optr : GSP_DiskFile;
  229. begin
  230.    if ObjtLog.Count > 0 then
  231.    begin
  232.       FileNameIs := '';
  233.       for i := 0 to ObjtLog.Count-1 do
  234.       begin
  235.          optr :=  ObjtLog.Items^[i];
  236.          if optr^.dfFileHndl = hdl then
  237.             FileNameIs := optr^.dfFileName;
  238.       end;
  239.    end
  240.    else FileNameIs := '';
  241. end;
  242.  
  243.  
  244.  
  245. Procedure GS_ClearLocks;
  246. var
  247.    i    : integer;
  248.    rslt : word;
  249.    optr : GSP_DiskFile;
  250. begin
  251.    if ObjtLog.Count > 0 then
  252.    begin
  253.       for i := 0 to ObjtLog.Count-1 do
  254.       begin
  255.          optr :=  ObjtLog.Items^[i];
  256.          with optr^ do
  257.             if dfLockRec then
  258.                rslt := GS_UnLockFile(dfFileHndl,dfLockPos,dfLockLth);
  259.       end;
  260.    end;
  261. end;
  262.  
  263. Function GS_Exclusive : boolean;
  264. begin
  265.    if not ShareChecked then
  266.       UseExclusive := not GS_ShareAllowed;
  267.    GS_Exclusive := UseExclusive;
  268. end;
  269.  
  270. Function GS_ExtendHandles(HndlCount : byte) : boolean;
  271. var
  272.    reg    : TRegisters;
  273.    hcnt   : word;
  274.    pfxcnt : pointer;
  275.    pfxtbl : pointer;
  276. begin
  277.    GS_ExtendHandles := false;
  278.    if HandlesExtnd then exit;
  279.    if HndlCount <= 20 then exit;
  280.    if lo(DosVersion) = 2 then exit;       { Can't handle DOS Ver 2}
  281.  
  282. {$IFDEF WINDOWS}
  283.    hcnt := SetHandleCount(HndlCount);
  284. {$ELSE}
  285. {$IFDEF DPMI}
  286.    Reg.BX := HndlCount;
  287.    Reg.AH := $67;
  288.    Reg.Ds := 0;
  289.    Reg.Es := 0;
  290.    MsDos(Reg);
  291. {$ELSE}
  292.    fillchar(NewHandleTable,sizeof(NewHandleTable),$FF);
  293.                                           { Initialize new handles as unused }
  294.    pfxcnt := Ptr(PrefixSeg, $0032);
  295.    pfxtbl := Ptr(PrefixSeg, $0034);
  296.  
  297.    OldNumHandles := byte(pfxcnt^); { Get old table length }
  298.    OldHandleTable := pointer(pfxtbl^);
  299.                                           { Save address of old table }
  300.    byte(pfxcnt^) := HndlCount;     { Set new table length }
  301.    pointer(Pfxtbl^) := Addr(NewHandleTable);
  302.                                           { Point to new handle table }
  303.    move(OldHandleTable^,NewHandleTable,OldNumHandles);
  304.             { Copy the current handle table to the new handle table }
  305. {$ENDIF}
  306. {$ENDIF}
  307.    HandlesExtnd := true;
  308.    GS_ExtendHandles := true;
  309. end;
  310.  
  311. Procedure GS_FileDateTime(var f: file; var Year,Month,Day,Hour,Min,Sec: Word);
  312. var
  313.    dt : TDateTime;
  314.    ftime : longint;
  315. begin
  316.    GetFTime(f,ftime); { Get creation time }
  317.    UnpackTime(ftime,dt);
  318.    Year := dt.Year;
  319.    Month := dt.Month;
  320.    Day := dt.Day;
  321.    Hour := dt.Hour;
  322.    Min := dt.Min;
  323.    Sec := dt.Sec;
  324. end;
  325.  
  326. {$IFDEF WINDOWS}
  327. Function  GS_FileExists(Fname : string) : boolean;
  328. var
  329.    NulEnd : array[0..80] of byte;
  330.    pNulEnd : PChar;
  331. begin
  332.    if (FName <> '') then
  333.    begin
  334.       pNulEnd := @NulEnd;
  335.       pNulEnd := StrPCopy(pNulEnd, FName);
  336.       FindFirst(pNulEnd, $27, FindFileInfo);
  337.       if DosError = 0 then
  338.          GS_FileExists := true
  339.       else
  340.       begin
  341.          GS_FileExists := false;
  342.          FillChar(FindFileInfo,SizeOf(FindFileInfo),#0);
  343.       end;
  344.    end
  345.    else
  346.    begin
  347.       GS_FileExists := false;
  348.       FillChar(FindFileInfo,SizeOf(FindFileInfo),#0);
  349.    end;
  350. end;
  351. {$ELSE}
  352. Function  GS_FileExists(Fname : string) : boolean;
  353. begin
  354.    if (FName <> '') then
  355.    begin
  356.       FindFirst(FName, $27, FindFileInfo);
  357.       if DosError = 0 then
  358.          GS_FileExists := true
  359.       else
  360.       begin
  361.          GS_FileExists := false;
  362.          FillChar(FindFileInfo,SizeOf(FindFileInfo),#0);
  363.       end;
  364.    end
  365.    else
  366.    begin
  367.       GS_FileExists := false;
  368.       FillChar(FindFileInfo,SizeOf(FindFileInfo),#0);
  369.    end;
  370. end;
  371. {$ENDIF}
  372.  
  373. Function GS_FileIsOpen(fnam : string): boolean;
  374. var
  375.    fmode : byte;
  376.    frslt : word;
  377.    filx  : file;
  378.    fopn  : boolean;
  379. begin
  380.    fmode := FileMode;
  381.    FileMode := 18;
  382.    System.Assign(filx, fnam);
  383.    frslt := IOResult;               {Clear IOResult}
  384.    {$I-}  System.Reset(filx); {$I+}
  385.    frslt := IOResult;
  386.    if frslt = 0 then System.Close(filx);
  387.    if frslt = 2 then frslt := 0;
  388.    fopn := frslt <> 0;
  389.    FileMode := fmode;
  390.    GS_FileIsOpen := fopn;
  391. end;
  392.  
  393.  
  394. Function GS_Flush(Hndl : word): Word;
  395. var
  396.   Reg: TRegisters;
  397. begin
  398.   Reg.AH := $45;             {DOS function to duplicate a file handle}
  399.   Reg.BX := Hndl;
  400.   Reg.Ds := 0;
  401.   Reg.Es := 0;
  402.   MsDos(Reg);
  403.   if Odd(Reg.Flags) then     {Check if carry flag is set}
  404.     begin
  405.       GS_Flush := 1;
  406.       exit;
  407.     end;
  408.   Reg.BX := Reg.AX;          {Put new file handle into BX}
  409.   Reg.AH := $3E;             {Dos function to close a file handle}
  410.   Reg.Ds := 0;
  411.   Reg.Es := 0;
  412.   MsDos(Reg);
  413.   if Odd(Reg.Flags) then     {Check if carry flag is set}
  414.     begin
  415.        GS_Flush := 2;
  416.        exit;
  417.     end;
  418.    GS_Flush := 0;
  419. end;
  420.  
  421. Function GS_LockFile(Hndl : word; FilePosition,FileLength : LongInt) : Word;
  422. var
  423.   Reg : TRegisters;
  424.   H,L : Word;
  425.   rsl : word;
  426. begin
  427.    if UseExclusive then
  428.    begin
  429.       if ShareAllowed then GS_LockFile := 0
  430.          else GS_LockFile := 1;
  431.       exit;
  432.    end;
  433.    with Reg do begin
  434.       Ax := $5C00; {DOS call 5Ch}
  435.       Bx := Hndl;
  436.       Cx := HiLong(FilePosition);
  437.       Dx := LowLong(FilePosition);
  438.       Si := HiLong(FileLength);
  439.       Di := LowLong(FileLength);
  440.       Ds := 0;
  441.       Es := 0;
  442.       MsDos(Reg);
  443.       if Odd(Reg.Flags) then     {Check if carry flag is set}
  444.          rsl := Ax
  445.       else
  446.          rsl := 0;
  447.    end;
  448.    GS_LockFile := rsl;
  449. end;
  450.  
  451. Function GS_RetryFile(Wait,Retry : Word) : Word;
  452. var
  453.   Reg : TRegisters;
  454. begin
  455.    if UseExclusive then
  456.    begin
  457.       if ShareAllowed then GS_RetryFile := 0
  458.          else GS_RetryFile := 1;
  459.       exit;
  460.    end;
  461.    with Reg do begin
  462.       Ax := $440B;
  463.       Cx := Wait;         {Num of 1/18 sec loops between retries (default = 1)}
  464.       Dx := Retry;        {Num of times to retry (default = 3)}
  465.       Ds := 0;
  466.       Es := 0;
  467.       MsDos(Reg);
  468.       if Odd(Reg.Flags) then     {Check if carry flag is set}
  469.          GS_RetryFile := Ax
  470.       else
  471.       begin
  472.          GS_RetryFile := 0;
  473.          RetriesChgd := true;
  474.       end;
  475.    end;
  476. end;
  477.  
  478. Function GS_UnLockFile(Hndl : word; FilePosition,FileLength : LongInt) : Word;
  479. var
  480.   Reg : TRegisters;
  481.   H,L : Word;
  482.   rsl : word;
  483. begin
  484.    if UseExclusive then
  485.    begin
  486.       if ShareAllowed then GS_UnlockFile := 0
  487.          else GS_UnLockFile := 1;
  488.       exit;
  489.    end;
  490.    with Reg do begin
  491.       Ax := $5C01; {DOS call 5Ch, subfunction 1}
  492.       Bx := Hndl;
  493.       Cx := HiLong(FilePosition);
  494.       Dx := LowLong(FilePosition);
  495.       Si := HiLong(FileLength);
  496.       Di := LowLong(FileLength);
  497.       Ds := 0;
  498.       Es := 0;
  499.       MsDos(Reg);
  500.       if Odd(Reg.Flags) then     {Check if carry flag is set}
  501.          rsl := Ax
  502.       else
  503.          rsl := 0;
  504.    end;
  505.    GS_UnLockFile := rsl;
  506. end;
  507.  
  508. Function GS_ShareAllowed : boolean;
  509. begin
  510.    if not ShareChecked then
  511.    begin
  512.       UseExclusive := false;
  513.       ShareAllowed := true;
  514.       ShareChecked := true;
  515.       AutomaticShare := true;
  516.    end;
  517.    GS_ShareAllowed := ShareAllowed;
  518. end;
  519.  
  520. Procedure  GS_SetExclusive(tf : boolean);
  521. begin
  522.    if GS_Exclusive then
  523.       if tf then exit;
  524.    if not ShareAllowed then
  525.       if not tf then exit;
  526.    UseExclusive := tf;
  527. end;
  528.  
  529. Procedure  GS_ShareAuto(tf : boolean);
  530. begin
  531.    if GS_ShareAllowed then AutomaticShare := tf
  532.       else AutomaticShare := false;
  533. end;
  534.  
  535. Function  GS_AutoShare : boolean;
  536. begin
  537.    GS_AutoShare := AutomaticShare;
  538. end;
  539.  
  540. {------------------------------------------------------------------------------
  541.                               GSO_DiskFile
  542. ------------------------------------------------------------------------------}
  543.  
  544. Constructor GSO_DiskFile.Init(Fname : string; Fmode : byte);
  545. var
  546.    attr : word;
  547. begin
  548.    dfFileMode := Fmode;
  549.    if GS_Exclusive then dfFileMode := dfFileMode and $07;
  550.    dfFileShrd := dfFileMode > 8;
  551.    Assign(FName);
  552.    dfFileHndl := 0;
  553.    dfFileRSiz := 0;
  554.    dfLockRec := false;
  555.    dfFileFlsh := NeverFlush;
  556.    ObjtLog.Insert(@Self);
  557. end;
  558.  
  559. destructor GSO_DiskFile.Done;
  560. begin
  561.    GSO_DiskFile.Close;
  562.    ObjtLog.Delete(@Self);
  563. end;
  564.  
  565. Procedure GSO_DiskFile.AddToFile(var dat; len, StepBack : word);
  566. var
  567.    LRslt : word;
  568.    FLen  : Longint;
  569. begin
  570.    FLen := FileSize - StepBack;
  571.    dfFileErr := IOResult;              {Clear IOResult}
  572.    (*$I-*) System.Seek(dFFileType, FLen); (*$I+*)
  573.    dfFileErr := IOResult;
  574.    IF dfFileErr = 0 THEN               {If seek ok, read the record}
  575.    begin
  576.       (*$I-*) BlockWrite(dfFileType, dat, len, dfGoodRec); (*$I+*)
  577.       dfFileErr := IOResult;
  578.       dfFilePosn := (FLen+len);
  579.    end;
  580.    if dfFileErr <> 0 then Error(dfFileErr,dskAddToFileError);
  581.    if (dfFileFlsh = WriteFlush) or
  582.       (dfFileFlsh = AppendFlush) then Flush;
  583. end;
  584.  
  585. Procedure GSO_DiskFile.Assign(FName : string);
  586. begin
  587.    dfFileName := FName;
  588.    dfFileExst := GS_FileExists(FName);
  589.    dfFileInfo := FindFileInfo;
  590.    if not dfFileExst then FillChar(dfFileInfo,SizeOf(dfFileInfo),#0);
  591.    {07/22/93 fix}
  592.    if (dfFileInfo.Attr and $01) > 0 then
  593.       if dfFileShrd then dfFileMode := dfReadOnly+dfSharedDenyWrite
  594.          else dfFileMode := dfReadOnly;
  595.  
  596.    System.Assign(dfFileType, FName);
  597.    DosError := 0;
  598.    dfFilePosn := 0;
  599. end;
  600.  
  601. Procedure GSO_DiskFile.Close;
  602. var
  603.    rsl : word;
  604. begin
  605.    if TFileRec(dfFileType).Mode = fmClosed then exit;
  606.    if dfLockRec then rsl := UnLock;
  607.    dfFileErr := IOResult;              {Clear IOResult}
  608.    (*$I-*) System.Close(dfFileType); {$I+}
  609.    dfFileErr := IOResult;
  610.    if dfFileErr <> 0 then Error(dfFileErr,dskCloseError);
  611. end;
  612.  
  613. Procedure GSO_DiskFile.Erase;
  614. begin
  615.    if dfFileShrd then Error(dosAccessDenied,dskEraseError)
  616.    else
  617.    begin
  618.       dfFileErr := IOResult;              {Clear IOResult}
  619.       (*$I-*) System.Erase(dfFileType); {$I+}
  620.       dfFileErr := IOResult;
  621.       if dfFileErr <> 0 then Error(dfFileErr,dskEraseError);
  622.    end;
  623. end;
  624.  
  625. Procedure GSO_DiskFile.Error(Code, Info : integer);
  626. begin
  627.    RunError(Code);
  628. end;
  629.  
  630. Function GSO_DiskFile.FileSize : longint;
  631. begin
  632.    dfFileErr := IOResult;              {Clear IOResult}
  633.    (*$I-*) FileSize := System.FileSize(dfFileType); {$I+}
  634.    dfFileErr := IOResult;
  635.    if dfFileErr <> 0 then Error(dfFileErr,dskFileSizeError);
  636. end;
  637.  
  638. Procedure GSO_DiskFile.Flush;
  639. begin
  640.    dfFileErr := GS_Flush(dfFileHndl);
  641.    if dfFileErr <> 0 then Error(dfFileErr,dskFlushError);
  642. end;
  643.  
  644. Function GSO_DiskFile.LockFile : Word;
  645. begin
  646.    LockFile := LockRec(0,FileSize*dfFileRSiz);
  647. end;
  648.  
  649. Function GSO_DiskFile.LockRec(FilePosition,FileLength: LongInt): Word;
  650. begin
  651.    if not dfFileShrd then dfFileErr := 1
  652.    else
  653.       if dfLockRec then
  654.       begin
  655.          if (FilePosition = dfLockPos) and (FileLength = dfLockLth) then
  656.             dfFileErr := 0
  657.          else
  658.             dfFileErr := dosLockViolated;
  659.       end
  660.       else
  661.       begin
  662.          dfLockPos := FilePosition;
  663.          dfLockLth := FileLength;
  664.          dfFileErr := GS_LockFile(dfFileHndl,dfLockPos,dfLockLth);
  665.          dfLockRec := dfFileErr = 0;
  666.       end;
  667.    LockRec := dfFileErr;
  668. end;
  669.  
  670. Procedure GSO_DiskFile.Read(blk : longint; var dat; len : word);
  671. begin
  672.    if blk = -1 then blk := dfFilePosn;
  673.    dfFileErr := IOResult;              {Clear IOResult}
  674.    (*$I-*) System.Seek(dFFileType, blk); (*$I+*)
  675.    dfFileErr := IOResult;
  676.    IF dfFileErr = 0 THEN               {If seek ok, read the record}
  677.    BEGIN
  678.       (*$I-*) BlockRead(dfFileType, dat, len, dfGoodRec); (*$I+*)
  679.       dfFileErr := IOResult;
  680.       dfFilePosn := (blk+len);
  681.    end;
  682.    if dfFileErr <> 0 then Error(dfFileErr,dskReadError);
  683. end;
  684.  
  685. Procedure GSO_DiskFile.Rename(Fname : string);
  686. begin
  687.    if dfFileShrd then Error(dosAccessDenied,dskRenameError)
  688.    else
  689.    begin
  690.       dfFileErr := IOResult;              {Clear IOResult}
  691.       (*$I-*) System.Rename(dfFileType, FName); {$I+}
  692.       dfFileName := Fname;
  693.       dfFileErr := IOResult;
  694.       if dfFileErr <> 0 then Error(dfFileErr,dskRenameError);
  695.    end;
  696. end;
  697.  
  698. Procedure GSO_DiskFile.Reset(len : word);
  699. var
  700.    Handle : word absolute dfFileType;
  701.    OldMode : byte;
  702. begin
  703.    OldMode := FileMode;
  704.    FileMode := dfFileMode;
  705.    dfFileErr := IOResult;              {Clear IOResult}
  706.    (*$I-*) System.Reset(dfFileType, len); (*$I+*)
  707.    dfFileErr := IOResult;
  708.    if dfFileErr <> 0 then Error(dfFileErr,dskResetError);
  709.    dfFilePosn := 0;
  710.    dfFileRSiz := len;
  711.    dfFileHndl := Handle;
  712.    FileMode := OldMode;
  713.    if dfFileShrd then
  714.       if LockRec(0,1) = 1 then
  715.          dfFileShrd := false
  716.       else dfFileErr := Unlock;
  717. end;
  718.  
  719. Procedure GSO_DiskFile.ReWrite(len : word);
  720. var
  721.    Handle : word absolute dfFileType;
  722.    OldMode : byte;
  723. begin
  724.    OldMode := FileMode;
  725.    FileMode := dfFileMode;
  726.    dfFileErr := IOResult;              {Clear IOResult}
  727.    (*$I-*) System.ReWrite(dfFileType, len); (*$I+*)
  728.    dfFileErr := IOResult;
  729.    if dfFileErr <> 0 then Error(dfFileErr,dskRewriteError);
  730.    dfFilePosn := 0;
  731.    dfFileRSiz := len;
  732.    dfFileHndl := Handle;
  733.    FileMode := OldMode;
  734.    if dfFileShrd then
  735.       if LockRec(0,1) = 1 then
  736.          dfFileShrd := false
  737.       else dfFileErr := Unlock;
  738. end;
  739.  
  740. Procedure GSO_DiskFile.SetFlushCondition(Condition : dfFlushStatus);
  741. begin
  742.    dfFileFlsh := Condition;
  743. end;
  744.  
  745. Procedure GSO_DiskFile.Truncate(loc : longint);
  746. begin
  747.    if dfFileShrd then Error(dosAccessDenied,dskTruncateError)
  748.    else
  749.    begin
  750.       if loc = -1 then loc := dfFilePosn;
  751.       dfFileErr := IOResult;              {Clear IOResult}
  752.       (*$I-*) Seek(dfFileType, loc); (*$I+*)
  753.       dfFileErr := IOResult;
  754.       if dfFileErr = 0 then
  755.       begin
  756.          (*$I-*) System.Truncate(dfFileType); {$I+}
  757.          dfFileErr := IOResult;
  758.       end;
  759.       if dfFileErr <> 0 then Error(dfFileErr,dskTruncateError)
  760.    end;
  761. end;
  762.  
  763. Function GSO_DiskFile.UnLock : Word;
  764. var
  765.    ulokok : word;
  766. begin
  767.    UnLock := 0;
  768.    if not dfLockRec then exit;
  769.    ulokok := GS_UnLockFile(dfFileHndl,dfLockPos,dfLockLth);
  770.    dfLockRec :=  ulokok <> 0;
  771.    UnLock := ulokok;
  772.    if dfFileFlsh = UnLockFlush then Flush;
  773. end;
  774.  
  775. Procedure GSO_DiskFile.Write(blk : longint; var dat; len : word);
  776. var
  777.    LRslt : word;
  778. begin
  779.    if blk = -1 then blk := dfFilePosn;
  780.    dfFileErr := IOResult;              {Clear IOResult}
  781.    (*$I-*) System.Seek(dFFileType, blk); (*$I+*)
  782.    dfFileErr := IOResult;
  783.    IF dfFileErr = 0 THEN               {If seek ok, read the record}
  784.    begin
  785.       (*$I-*) BlockWrite(dfFileType, dat, len, dfGoodRec); (*$I+*)
  786.       dfFileErr := IOResult;
  787.       dfFilePosn := (blk+len);
  788.    end;
  789.    if dfFileErr <> 0 then Error(dfFileErr,dskWriteError);
  790.    if dfFileFlsh = WriteFlush then Flush;
  791. end;
  792.  
  793. {------------------------------------------------------------------------------
  794.                            Setup and Exit Routines
  795. ------------------------------------------------------------------------------}
  796.  
  797. {$F+}
  798. procedure ExitHandler;
  799. var
  800.    rslt : word;
  801. begin
  802.    GS_ClearLocks;
  803.    if RetriesChgd then
  804.    begin
  805.       UseExclusive := false;
  806.       rslt := GS_RetryFile(1,3);
  807.    end;
  808.    ExitProc := ExitSave;
  809. end;
  810. {$F-}
  811.  
  812. begin
  813.    ObjtLog.Init(32,16);
  814.    ExitSave := ExitProc;
  815.    ExitProc := @ExitHandler;
  816. end.
  817. {-----------------------------------------------------------------------------}
  818.                                    END
  819.  
  820.